home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2002 June / PC-WELT 6-2002.ISO / pcwsoft / saveversion.exe / SaveVersion.bas
Encoding:
BASIC Source File  |  2002-04-10  |  1.6 KB  |  44 lines
  1. Attribute VB_Name = "SaveVersion"
  2. Sub BackupSpeichen()
  3. Dim fso, msg
  4. 'Pfad zu "Eigene Dateien" ermitteln
  5. Set WshShell = CreateObject("WScript.Shell")
  6. myDocumentsPath = WshShell.SpecialFolders("MyDocuments")
  7. 'Backupverzeichnis festlegen
  8. myBackupDir = myDocumentsPath & "\" & "Backup" & "\"
  9. 'Backupverzeichnis erstellen wenn nicht vorhanden
  10. Set fso = CreateObject("Scripting.FileSystemObject")
  11.   If Not (fso.FolderExists(myBackupDir)) Then MkDir myBackupDir
  12. 'Dokument schon gespeichert?
  13. If Not Application.ActiveDocument.FullName = Application.ActiveDocument.Name Then
  14.   'diverse Variablen festlegen
  15.   myFilePath = Application.ActiveDocument.FullName
  16.   myFileName = Application.ActiveDocument.Name
  17.   myDocName = Mid(myFileName, 1, InStr(myFileName, "."))
  18.   DocVersion = ActiveDocument.BuiltInDocumentProperties("Revision Number")
  19.   myExt = Mid(myFileName, InStr(myFileName, "."), Len(myFileName))
  20.   myDate = Year(Date) & Month(Date) & Day(Date)
  21.   myTime = Hour(Time) & "." & Minute(Time) & "." & Second(Time)
  22.   myVer = DocVersion & "_" & myDate & "_" & myTime
  23.      'Varianten
  24.      'myVer = DocVersion
  25.      'oder
  26.      'myVer = "_" & myDate & "_" & myTime
  27.   'aktuelles Dukument kopieren
  28.    If Left$(Application.Version, 1) = "8" Then
  29.      'Word 97
  30.      WordBasic.CopyFile Filename:=myFilePath, _
  31.      Directory:=myBackupDir & myDocName & myVer & myExt
  32.    Else
  33.     'Word 2000/XP
  34.      WordBasic.CopyFileA Filename:=myFilePath, _
  35.      Directory:=myBackupDir & myDocName & myVer & myExt
  36.    End If
  37.  
  38. Else
  39. MsgBox ("Sie mⁿssen das Dokument erst speichern.")
  40. End If
  41.  
  42. End Sub
  43.  
  44.